(** Module Diagnostics contains: 
 *  - error reporting functions
 *  - functions for IL-tree dumping
 *
 *  Author: Ilia
 *)

open IL
open Misc
open Generation
open Production

(** function for error reporting *)
let reportError msg = Printf.printf "Error: %s\n" msg

(** methods for tree dumping *)

let listToString elemToString sep l =  
    l ++ List.map elemToString ++ String.concat sep

let sourceListToString = listToString getText " "

let printPairList l = 
    l ++ listToString (fun (x, y) -> sprintf "(%s %s)" x y) ";"
      ++ print_endline (*print_string*)

let dumpParams = sourceListToString

let printPredicate = sprintf "%s  predicate: %s\n"    

let rec dumpRule indent = 
    let indent' = indent ^ "  " in
    function
    PAlt (l, r) -> 
      let l' = dumpRule indent' l
      and r' = dumpRule indent' r
      in sprintf "Alt:\n%s- %s%s- %s" indent' l' indent' r'
    |POpt r  -> sprintf "Option:\n%s- %s" indent' (dumpRule indent' r) 
    |PSome r -> sprintf "Some(+):\n%s- %s" indent' (dumpRule indent' r)
    |PMany r -> sprintf "Many(*):\n%s- %s" indent' (dumpRule indent' r)
    |PSeq (seq, a) ->  
     let elem e = ( genOptText e.binding
                  , dumpRule indent' e.rule
                  , genOptText e.checker
                  )                   
     in let rec genList = function
        | [] -> ""
        | h::t -> 
          let (bind, h', pr) = elem h in
          match t with 
          | [] -> sprintf "< %s >= %s%s" bind h' (printPredicate indent' pr)
          | _ -> sprintf "< %s >= %s%s%s- %s" bind h' 
                 (printPredicate indent' pr) indent' (genList t)
     in sprintf "Seq:\n%s- %s%s- Action{ %s }\n" indent' (genList seq) 
                                               indent' (genOptText a)
    |PRef (r, p) -> 
     sprintf "Ref: %s\n%s- Params: %s\n" (getText r) indent' (genOptText p)
    |PMetaRef (r, p, mp) -> 
     sprintf "MetaRef: %s\n%s- Params: %s\n%s- MetaParams: %s\n" (getText r) 
       indent' (genOptText p)
       indent' (dumpParams mp)
    |PToken t -> sprintf "Token: %s\n"  (getText t)
    |PLiteral r -> sprintf "Literal: %s\n" (getText r)

let dumpItem r = 
    sprintf "Rule %s: \n- Params: %s\n- Body %s\n"
      r.Rule.name
      (dumpParams r.Rule.args)
      (dumpRule "" r.Rule.body)

let dumpIL fname tree =    
    let textList = List.map (dumpItem) tree 
    in let outChan = open_out_bin fname 
    in List.map (output_string outChan) textList

let dumpTree = dumpIL "IL.dump"

(* end of module Diagnostics *)
